home *** CD-ROM | disk | FTP | other *** search
- /* Create_BarGraph
- A Macro by Steven. R. Giovenella, 5823 Dutchess Dr., Colorado Springs, CO 80918.
- © Copyright 1994 Steven. R. Giovenella, All rights reserved.
- This macro is my gift to the Amiga community. It may be given away free to
- anyone, but it may NOT be sold in any way, shape, or form, not even for the cost of
- reproduction, downloading, shipping, or handling, without express written
- permission from the author listed above. Any person or company who violates the
- content of the previous sentence, agrees to pay Steven R. Giovenella $1,000 (US) for
- each copy of this macro sold. This macro may NOT be added to any disk which is to
- be sold for any price or fee, to include shipping and handling. The ONLY way this
- macro may be distributed is on a disk which is given away 100% free of all charges,
- or on via telecommunications networks which do not charge any additional fee as a
- result of a user downloading this particular macro. This macro may only be
- reproduced in its entirety, including all comment lines and code. The individual
- user may alter this macro for personal use, but may not then distribute the macro
- in any modified form. If you wish, feel free to send me some cash, a Christmas card,
- some other piece of software, or absolutely nothing as a gift for creating this macro.
- The author of this software is not responsible for any data loss or damage to
- computer equipment as a result, direct or indirect, of the use of this macro. */
-
- Options Results
-
- /****************************/
- /* Ask questions */
-
- /* Warning */
- Showmessage 2 0 '" ** WARNING **" " This Macro
- will alter the current document." "Unless the document is empty, save before
- proceeding." " Proceed " " Save now " " Quit "'
- IF Result = 2 THEN SaveAs
- IF Result = 3 THEN Exit
-
- ShowMessage 1 0 '"Select border option..." "" "" " 2 pts " " 1 pt " "
- None "'
- IF Result = 1 THEN border = 2
- IF Result = 2 THEN border = 1
- IF Result = 3 THEN border = None
- ShowMessage 1 0 '"Select text flow..." "" "" " Left " " Right " " None
- "'
- IF Result = 1 THEN tflow = LeftVert
- IF Result = 2 THEN tflow = RightVert
- IF Result = 3 THEN tflow = None
- RequestText '"Create Bar Graph" "Enter maximum value for vertical axis" ""'
- maxY = Result
- RequestText '"Create Bar Graph" "Enter vertical axis increments" ""'
- increment = Result
-
- /***********************************************/
- /* Data Interpreter */
-
- /* Store current begline and endline */
- Status LinePos
- Coords = Result
- PARSE VAR Coords BegLine BegPos EndLine EndPos
- IF ( EndLine = "" ) THEN DO
- ShowMessage 1 0 '"No Range Selected" "" "" " OK " "" ""'
- Exit
- END
- IF EndPos=0 THEN EndLine=EndLine-1
-
- /* Count bars */
- bars = EndLine - BegLine - 2
-
- /* Get Title */
- MoveToLine BegLine 0
- ShiftDown
- CtrlDown
- AltDown
- Cursor right
- Extract
- title.1 = Result
- ShiftUp
- CtrlUp
- AltUp
-
- /* Get Subtitle */
- MoveToLine BegLine+1 0
- ShiftDown
- CtrlDown
- AltDown
- Cursor right
- Extract
- title.2 = Result
- ShiftUp
- CtrlUp
- AltUp
-
- /* Get rest of data */
- /* Add Trailing Spaces */
- DO line = (BegLine+3) to EndLine
- MoveToLine line 0
- CtrlDown
- AltDown
- Cursor right
- type " "
- END
-
- /* Extract Data x.0 and y.0 through x.count and y.count */
- count = 0
- DO line = (BegLine+2) to EndLine
- MoveToLine line 0
- Status ParaChars
- pchars = Result
- DO i=0 to pchars
- MoveToLine line i
- Extract
- char = Result
- IF char = " " THEN LEAVE
- END
- MoveToLine line i
- ShiftDown
- CtrlDown
- AltDown
- Cursor left
- Extract
- x.count = Result
- ShiftUp
- MoveToLine line (i+1)
- ShiftDown
- Cursor right
- AltUp
- CtrlUp
- IF line ~= (Begline+2) THEN Cursor left
- Extract
- r = Result
- IF count = 0 THEN y.count = r
- ELSE DO
- PARSE VAR r r1
- y.count = Value('r1')
- END
- ShiftUP
- CtrlUp
- AltUP
- count = count +1
- END
-
- /***********************************************/
- /* Draw graph */
-
- /* Get precise coordinates for placing graph */
- /* In order to get scroll position */
- /* Move to end of document */
- CtrlDown
- AltDown
- Cursor Down
- CtrlUP
- AltUp
-
- /* Insert a page break */
- InsertPageBreak
-
- /* Movetoline begline */
- MoveToLine BegLine 0
-
- /* Get scroll position */
- Status ScrollPos
- Coords = Result
- PARSE VAR Coords scrollX scrollY
-
- /* Draw matt */
- BoxPrefs TEXTFLOW tflow LINEWT border FILL solid FILLCOLOR white
- DrawBox 1 1 scrollY 6.5 5.5
- firstobject = Result
-
- /* Draw Grid */
- scaleheight = 2.5 / maxY
- LinePrefs TEXTFLOW none LINEWT hairline LINECOLOR black
- IF increment = 0 THEN CALL skipgrid
- DO i = 1 to TRUNC( maxY / increment)
- ygrid = scrollY + 4.25 - increment * i * scaleheight
- DrawLine 1 2.375 ygrid 7 ygrid
- END
- DrawLine 1 2.375 scrollY+4.25 7 scrollY+4.25
- ygrid = scrollY + 4.25 - maxY * scaleheight
- DrawLine 1 7 ygrid 7 scrollY + 4.25
-
- /* Draw Y Axis Numbers */
- TextBlockTypePrefs SIZE 14 COLOR Black
- DrawTextBlock 1 2 scrollY+4.185 "0"
- DO i = 1 to maxY / increment
- ypos = ScrollY + 4.185 - (increment * i * scaleheight)
- DrawTextBlock 1 2 ypos increment * i
- END
-
- skipgrid:
-
- /* Draw Bars */
- BoxPrefs TEXTFLOW none LINEWT 1 LINECOLOR Black FILL Solid
- barwidth = 3.5 / bars
- largeY= y.1
- DO i=1 to (bars-1)
- nextY = i+1
- largeY = MAX( largeY , y.nextY )
- END
- DO i=1 to bars
- color.1 = 'red'
- q = i - 1
- IF color.q= 'red' THEN color.i = 'yellow'
- IF color.q = 'yellow' THEN color.i = 'magenta'
- IF color.q = 'magenta' THEN color.i = 'green'
- IF color.q = 'green' THEN color.i = 'cyan'
- IF color.q = 'cyan' THEN color.i = 'brown'
- IF color.q = 'brown' THEN color.i = 'red'
- BoxPrefs FILLCOLOR color.i
- lbox = 3 + (barwidth * i ) - barwidth
- tbox = scrollY + 4.25 - (y.i * scaleheight)
- hbox = y.i * scaleheight
- DrawBox 1 lbox tbox barwidth hbox
- DrawTextBlock 1 lbox (tbox-.2) y.i
- /* position number */
- GetObjectCoords
- coords = Result
- PARSE VAR coords page x1 y1 twidth theight
- thalf = twidth / 2
- xpos = x1 - thalf + barwidth/2
- SetObjectCoords 0 1 xpos tbox-.2 twidth theight
- lline = lbox + barwidth / 2
- IF bars>2 THEN DO
- IF i/2 = TRUNC(i/2) THEN DO
- DrawLine 1 lline scrollY+4.25 lline scrollY+4.5625
- END
- END
- DrawLine 1 lline scrollY+4.25 lline scrollY+4.375
- END
- BoxPrefs LINEWT none FILL solid FILLCOLOR white
-
- /* Draw lables */
- /* Title */
- TextBlockTypePrefs SIZE 28 OBLIQUE 2
- DrawTextBlock 1 2 scrollY title.1
- GetObjectCoords
- coords = Result
- PARSE VAR coords page x1 y1 twidth theight
- thalf = twidth / 2
- xpos = 4.25 - thalf
- SetObjectCoords 0 1 xpos scrollY+.25 twidth theight
-
- /* SubTitle */
- TextBlockTypePrefs SIZE 20 OBLIQUE 2
- DrawTextBlock 1 2 scrollY title.2
- GetObjectCoords
- coords = Result
- PARSE VAR coords page x1 y1 twidth theight
- thalf = twidth / 2
- xpos = 4.25 - thalf
- SetObjectCoords 0 1 xpos scrollY+.75 twidth theight
-
- /* X axis */
- TextBlockTypePrefs SIZE 18 OBLIQUE 0
- DrawTextBlock 1 2.5 scrollY+4.75 x.0
- GetObjectCoords
- coords = Result
- PARSE VAR coords page x1 y1 twidth theight
- thalf = twidth / 2
- xpos = 4.75 - thalf
- SetObjectCoords 0 1 xpos (scrollY+5) twidth theight
-
- /* Yaxis */
- DO i=1 to LENGTH(y.0)
- yind.i = SUBSTR(y.0 , i , 1)
- END
- TextBlockTypePrefs SIZE 18
- ypos = scrollY + 3 - LENGTH(y.0) / 2 * .2
- DO i=1 to LENGTH(y.0)
- DrawTextBlock 1 1.25 ypos yind.i
- ypos = ypos + .2
- END
-
- /* Draw Bar labels */
- TextBlockTypePrefs SIZE 12 COLOR Black
- DO i=1 to bars
- labelxpos = 3 + (i * barwidth) - (.5 *barwidth)
- labelypos = scrollY + 4.4
- DrawTextBlock 1 labelxpos labelypos x.i
- lastobject = Result
- GetObjectCoords
- coords = Result
- PARSE VAR coords page x1 y1 twidth theight
- thalf = twidth / 2
- xpos = labelxpos - thalf
- IF bars>2 THEN DO
- IF i/2 = TRUNC(i/2) THEN labelypos = labelypos + .2
- END
- SetObjectCoords 0 1 xpos labelypos twidth theight
- END
-
- /* Draw Axes */
- LinePrefs TEXTFLOW none LINEWT 2 LINECOLOR Black
- ypos = scrollY+4.25
- DrawLine 1 2.5 ypos 7.125 ypos
- DrawLine 1 2.5 ypos 2.5 scrollY+1.58
- lastobject = Result
-
- /* Group all */
- DO i=firstobject to lastobject
- SelectObject i MULTIPLE
- END
- Group
-
- /***********************************************/
- /* Clean up */
-
- /* Remove extra page */
- CtrlDown
- AltDown
- Cursor Down
- Backspace
- MoveToLine Begline 0
-
- Redraw
-
-